home *** CD-ROM | disk | FTP | other *** search
/ Tech Arsenal 2 / Tech Arsenal 2 (Arsenal Computer).iso / clipper / s93bsp.exe / S87 / REP00.PRG < prev   
Encoding:
Text File  |  1993-09-28  |  8.1 KB  |  270 lines
  1. * R E P 0 0
  2. procedure REPMAIN
  3. *       Main controlling routine for reports
  4. private SWIDTH, BWIDTH, REPCOM, CGROUP, STARTD, FINISHD, OLDSCR
  5. public REPHD1, REPHD2, REPHD3, REPHD4, REPHD5
  6.  
  7. store 8 to SWIDTH, BWIDTH
  8. store space(4) to CGROUP
  9. store blank(date()) to STARTD, FINISHD
  10. set deleted on
  11. @ 4,22 clear to 20,58
  12.  
  13. do while .t.
  14.     store "" to REPHD1,REPHD2, REPHD3, REPHD4, REPHD5
  15.  
  16.     GETOUT = .f.
  17.     REPCOM = QBPROMPT("Current Work|List|Revenue|Quit|","Reports can be between two dates, and for a Customer type",1)
  18.  
  19.     do case
  20.     case REPCOM=1       && Work in Progress
  21.         do REPARAM with CGROUP, STARTD, FINISHD, "Work in Progress"
  22.         if .not. GETOUT
  23.             save screen to OLDSCR
  24.             do REPWIP with CGROUP, STARTD, FINISHD
  25.             restore screen from OLDSCR
  26.         endif
  27.     case REPCOM=2
  28.         do REPARAM with CGROUP, STARTD, FINISHD, "List of Invoices"
  29.         if .not. GETOUT
  30.             save screen to OLDSCR
  31.             do REPLIST with CGROUP, STARTD, FINISHD
  32.             restore screen from OLDSCR
  33.         endif
  34.     case REPCOM=3
  35.         do REPARAM with CGROUP, STARTD, FINISHD, "Invoice Revenue"
  36.         if .not. GETOUT
  37.             save screen to OLDSCR
  38.             do REPREV with CGROUP, STARTD, FINISHD
  39.             restore screen from OLDSCR
  40.         endif
  41.     case REPCOM=4 .or. REPCOM=0
  42.         exit
  43.     endcase
  44.     close database
  45. enddo
  46. return
  47.  
  48. ***********************************************************************
  49.  
  50. procedure REPARAM
  51. parameters CGROUP, STARTD, FINISHD, RTITLE
  52. private M, RORDER
  53. M = "Choose Order for Report"
  54. do QBLAYOUT with RTITLE
  55. do QBBOX with 40
  56.  
  57. CGROUP = blank(CGROUP)
  58. @ 5,26 say "Customer Group:" get CGROUP picture "!!!!" valid VCUSTTYP(5,42,.t.)
  59.  
  60. if .not. "Progress"$RTITLE
  61.     @ 7,27 say  "Start date:"
  62.     @ 9,26 say "Finish date:"
  63.     do QB2DATES with "Group, Start & Finish dates - blank implies ALL",7,39,STARTD,9,39,FINISHD
  64. else
  65.     do QBREAD with "Enter Customer Group - blank implies ALL"
  66.     STARTD = blank(date())
  67.     FINISHD = ctod("31/12/99")
  68. endif
  69. if .not. GETOUT
  70.     CGROUP = MCUSTTYP
  71.     if empty(CGROUP)
  72.         RORDER = substr("DCQ",QBPROMPT("Date|Customer group|Quit|",M,1),1)
  73.         REPHD3 = "Listing for ALL Customer Groups"
  74.     else
  75.        RORDER = "D"
  76.        REPHD3 = "Listing for Customer Group  "+trim(MCDESC)
  77.     endif
  78.     GETOUT = (QBRESP="Q")
  79. endif
  80. if GETOUT
  81.     return
  82. endif
  83.  
  84. REPHD1 = QBTITLE+space(10)+RTITLE+space(10)+QBDATE
  85. REPHD3 = center(trim(REPHD3)+"   -  Ordered by "+iif(RORDER="C","Group","Date"),79)
  86.  
  87. select 0
  88. use INVOICE
  89. set softseek on
  90. do case
  91. case RORDER="D"
  92.     set index to INVDATE
  93.     seek dtos(STARTD) + trim(CGROUP)
  94.     GETOUT = (eof()) .or. (INVOICE->DATEOUT>FINISHD)
  95. case RORDER="C"
  96.     set index to INVCUST
  97.     seek "!   "+dtos(STARTD)
  98.     if found()
  99.         do while (.not. eof()) .and. (INVOICE->DATEOUT<STARTD)
  100.             skip
  101.         enddo
  102.         GETOUT = (INVOICE->DATEOUT>FINISHD) .or. (eof())
  103.     endif
  104. endcase
  105.  
  106. if GETOUT
  107.     do QBMESS with "No matching Invoices",COLFLASH,5
  108. else
  109.     select 0
  110.     use PARTS index PARTINV alias PARTS
  111.     select INVOICE
  112.     do QBPRCTL with " "
  113. endif
  114.  
  115. return
  116.  
  117. ***********************************************************************
  118.  
  119. function REPMORE
  120. parameters STARTD, FINISHD
  121.  
  122. RETVAL = (INVOICE->DATEOUT>=STARTD .and. INVOICE->DATEOUT<=FINISHD)
  123. RETVAL = RETVAL .and. (.not. (eof() .or. GETOUT))
  124.  
  125. return RETVAL
  126.  
  127. ***********************************************************************
  128.  
  129. function REPGROUP
  130. parameters CGROUP
  131.  
  132. RETVAL = (empty(CGROUP) .or. CGROUP=INVOICE->CUSTTYPE)
  133.  
  134. return RETVAL
  135.  
  136. ***********************************************************************
  137.  
  138. procedure REPLIST
  139. *       List of Invoice between two dates for a customer type
  140. parameters CGROUP, STARTD, FINISHD
  141. private M, LMARG
  142.  
  143. LMARG = iif(PDEST="S","",space(5))
  144. do QBPUTH with 1,LMARG+REPHD1
  145. do QBPUTH with 3,LMARG+REPHD3
  146. M = LMARG + "Invoice  Owner Name"+space(15)+"Vehicle    Date in  Date out"
  147. do QBPUTH with 5,M
  148. do QBPUTH with 6," "
  149. do while REPMORE(STARTD,FINISHD)
  150. * 99999   XXXXXXXXXXXXXXXXXXXXXXXX X999XXXX  99/99/99  99/99/99
  151.     if REPGROUP(CGROUP)
  152.         M = LMARG + " "
  153.         M = M + str(INVOICE->INVNO,5)+"   "+INVOICE->OWNNAME+" "
  154.         M = M + INVOICE->REGNO+"  "+dtoc(INVOICE->DATEIN)+"  "
  155.         M = M + dtoc(INVOICE->DATEOUT)
  156.         do QBPUTL with 1,M
  157.     endif
  158.     skip
  159. enddo
  160.  
  161. do QBPRCTL with [R:Finished  "Invoice List"]
  162.  
  163. return
  164.  
  165. ***********************************************************************
  166.  
  167. procedure REPREV
  168. *       Revenue for Customer group between two dates
  169. parameters CGROUP, STARTD, FINISHD
  170. private TL, TP, TS, TV, TO, TI, TT
  171. store 0 to TL, TP, TS, TV, TO, TI, TT
  172. private M, LMARG
  173.  
  174. LMARG = iif(PDEST="S","",space(5))
  175. do QBPUTH with 1,LMARG+REPHD1
  176. do QBPUTH with 3,LMARG+REPHD3
  177. if PDEST="S"
  178.     SWIDTH = 6
  179.     BWIDTH = 8
  180.     M = "Invoice  Date     Labour     Total Special   V A T   Contributions     Total"
  181. else
  182.     store 10 to SWIDTH, BWIDTH
  183.     M = LMARG+"Invoice    D a t e s       Labour     Total   Special     V A T      Contributions      Total"
  184. endif
  185. do QBPUTH with 5,M
  186. if PDEST="S"
  187.     M = "Number   Out      Charge     Parts Mater'l           Owner  Ins Co"
  188. else
  189.     M = LMARG+"Number    In       Out     Charge     Parts   Mater'l               Owner    Ins Co"
  190. endif
  191. do QBPUTH with 6,M
  192. do QBPUTH with 7," "
  193. *    99999 99/99/99 99/99/99 999999.99 999999.99 999999.99 999999.99 999999.99 999999.99 999999.99
  194. do while REPMORE(STARTD,FINISHD)
  195.     if REPGROUP(CGROUP)
  196.         INVFILL(.f.)
  197.         do INVTOTAL with .f.
  198.         M = LMARG+str(MINVNO,5)+iif(PDEST="S",""," "+dtoc(MDATEIN))+" "+dtoc(MDATEOUT)
  199.         M = M + str(MLABOURT,10,2)+str(MINSPART+MOWNPART,10,2)
  200.         M = M + str(MINSSPEC+MOWNSPEC,BWIDTH,2)+str(IVATAMT+OVATAMT,BWIDTH,2)
  201.         M = M + str(MOWNDUE,BWIDTH,2)+str(MINSDUE,BWIDTH,2)+str(MINVTOTAL,10,2)
  202.         TL = TL + MLABOURT
  203.         TP = TP + MINSPART+MOWNPART
  204.         TS = TS + MINSSPEC+MOWNSPEC
  205.         TV = TV + IVATAMT+OVATAMT
  206.         TO = TO + MOWNDUE
  207.         TI = TI + MINSDUE
  208.         TT = TT + MINVTOTAL
  209.         do QBPUTL with 1,M
  210.     endif
  211.     skip
  212. enddo
  213.  
  214. M = LMARG+space(iif(PDEST="S",8,17))+"Totals"+str(TL,10,2)+str(TP,10,2)+str(TS,BWIDTH,2)+str(TV,BWIDTH,2)
  215. M = M + str(TO,BWIDTH,2)+str(TI,BWIDTH,2)+str(TT,10,2)
  216. do QBPUTL with 2,M
  217.  
  218. do QBPRCTL with [R:Finished  "Revenue Report"]
  219.  
  220. return
  221.  
  222. ***********************************************************************
  223.  
  224. procedure REPWIP
  225. *       Work in Progress report
  226. parameters CGROUP, STARTD, FINISHD
  227. *       Revenue for Customer group between two dates
  228. private TL, TP, TS, TV, TO, TI, TT
  229. store 0 to TL, TP, TS, TV, TO, TI, TT
  230. private M, LMARG
  231. LMARG = iif(PDEST="S","",space(5))
  232.  
  233. do QBPUTH with 1,LMARG+REPHD1
  234. do QBPUTH with 3,LMARG+REPHD3
  235. M = LMARG+"Invoice    D a t e s       Labour     Total   Special    V A T      Contributions     Total"
  236. do QBPUTH with 5,M
  237. M = LMARG+"Number    In       Out     Charge     Parts   Mater'l               Owner    Ins Co"
  238. do QBPUTH with 6,M
  239. do QBPUTH with 7," "
  240. *    99999 99/99/99 99/99/99 9999.99 9999.99 9999.99 9999.99 9999.99 9999.99 9999.99
  241.  
  242. do while .not. eof()
  243.     if INVNO<>0 .and. DATEINV=ctod("") .and. REPGROUP(CGROUP)
  244.         INVFILL(.f.)
  245.         do INVTOTAL with .f.
  246.         M = LMARG+str(MINVNO,5)+" "+dtoc(MDATEIN)+" "+dtoc(MDATEOUT)
  247.         M = M + str(MLABOURT,BWIDTH,2)+str(MINSPART+MOWNPART,BWIDTH,2)
  248.         M = M + str(MINSSPEC+MOWNSPEC,SWIDTH,2)+str(IVATAMT+OVATAMT,BWIDTH,2)
  249.         M = M + str(MOWNDUE,SWIDTH,2)+str(MINSDUE,BWIDTH,2)+str(MINVTOTAL,BWIDTH,2)
  250.         TL = TL + MLABOURT
  251.         TP = TP + MINSPART+MOWNPART
  252.         TS = TS + MINSSPEC+MOWNSPEC
  253.         TV = TV + IVATAMT+OVATAMT
  254.         TO = TO + MOWNDUE
  255.         TI = TI + MINSDUE
  256.         TT = TT + MINVTOTAL
  257.         do QBPUTL with 1,M
  258.     endif
  259.     skip
  260. enddo
  261.  
  262. M = LMARG+space(17)+"Totals"+str(TL,BWIDTH,2)+str(TP,BWIDTH,2)+str(TS,SWIDTH,2)+str(TV,BWIDTH,2)
  263. M = M + str(TO,SWIDTH,2)+str(TI,BWIDTH,2)+str(TT,BWIDTH,2)
  264. do QBPUTL with 2,M
  265.  
  266. do QBPRCTL with [R:Finished  "Current Work"]
  267.  
  268. return
  269.  
  270.